home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / swindows.zip / LABELS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-04-09  |  4KB  |  149 lines
  1. program labels;
  2. {
  3.             A Program to print mailing labels
  4.             Written to demonstrate use of the INPUT.TPU unit.
  5.  
  6.             by David C. Swaim II, Ph.D.  (3/88)
  7.                P. O. Box 1658
  8.                Lawrenceville, GA. 30246
  9. }
  10. uses
  11.    Crt,Printer,Input,hwindows;
  12.  
  13. const
  14.    CtrlEnd = #117;
  15.  
  16. var
  17.    CursorX,CursorY:                      Byte;
  18.    NoLabels,i,LineNo,ColNo:  Integer;
  19.    LabelLines:               array[1..5] of InputString;
  20.    ScrnPtr:                  Pointer;
  21.  
  22. Procedure PrintLabels;
  23.  
  24. var
  25.    i,j:    Integer;
  26.    InKey:  Char;
  27.  
  28. begin
  29.   Inkey := NULL;
  30.   for j := 1 to NoLabels do
  31.       begin
  32.         for i := 1 to 5 do Writeln(Lst,LabelLines[i]);
  33.         Writeln(Lst,' ');
  34.         if KeyPressed then Inkey := ReadKey;
  35.         if Inkey = Esc then Exit;
  36.       end;
  37. end;
  38.  
  39. begin
  40.    CursorX := WhereX;
  41.    CursorY := WhereY - 1;
  42.    SaveScreen(ScrnPtr);
  43.    ClrScr;
  44.    NOLabels := 1;
  45.    for i := 1 to 5 do
  46.       begin
  47.          LabelLines[i] := '';
  48.       end;
  49.    TextColor(Yellow);
  50.    GotoXY(25,1);
  51.    Writeln('Label Printer Program');
  52.    GotoXY(25,3);
  53.    TextColor(LightGray);
  54.    Writeln('From Simple Software Solutions');
  55.    GotoXY(25,4);
  56.    Writeln('     P. O. Box 1658');
  57.    GotoXY(25,5);
  58.    Writeln('     Lawrenceville, Georgia 30246');
  59.    Writeln;
  60.    TextColor(LightCyan);
  61.    Writeln('A program to print standard 3.5" X 15/16" labels (five lines).');
  62.    Writeln;
  63.    TextColor(Yellow);
  64.    Write('Number of Labels to Print: ');
  65.    TextColor(LightGray);
  66.    Writeln(NoLabels:3);
  67.    GotoXY(1,11);
  68.    TextColor(White);
  69.    Writeln('        +---------+---------+---------+---------+');
  70.    TextColor(Yellow);
  71.    Writeln('Line 1:');
  72.    Writeln('Line 2:');
  73.    Writeln('Line 3:');
  74.    Writeln('Line 4:');
  75.    Writeln('Line 5:');
  76.    TextColor(White);
  77.    Writeln('        +---------+---------+---------+---------+');
  78.    GotoXY(1,21);
  79.    TextColor(LightRed);
  80.    Writeln('F1 = Print Label   Ctrl End = End Program');
  81.    NoLabels := 1;
  82.    LineNo := 0;
  83.    FileIn := False;
  84.    TextColor(LightGray);
  85. {
  86.     CtrlEnd or Esc will end the program.
  87. }
  88.    While (Control <> Esc) and (Control <> CtrlEnd) do         { Ctrl End stops program }
  89.       begin
  90.  
  91.          if LineNo = 0 then
  92.             begin
  93.               Str(NoLabels:3,Indata);
  94.               Maxin := 3;
  95.               Insrt := False;
  96.               Numin := True;
  97.               x := 28;
  98.               y := 9;
  99.             end
  100.          else
  101.             begin
  102.               Indata := LabelLines[LineNo];
  103.               Maxin := 40;
  104.               Insrt := True;
  105.               Numin := False;
  106.               x := 9;
  107.               y := LineNo + 11;
  108.             end;
  109.  
  110.          GetIn(Numin,FileIn,Maxin,x,y,Indata,Insrt,Control,Number);
  111.  
  112.          if LineNo = 0 then
  113.             NoLabels := Trunc(Number)
  114.          else
  115.             LabelLines[LineNo] := Indata;
  116.  
  117.          if Control <> NULL then
  118.             Case Control of
  119.                CsrUp: begin
  120.                         LineNo := LineNo - 1;
  121.                         if LineNo < 0 then LineNo := 5;
  122.                       end;
  123.                CsrDn: begin
  124.                         LineNo := LineNo + 1;
  125.                         if LineNo > 5 then LineNo := 0;
  126.                       end;
  127.                   F1: begin
  128.                         GotoXY(1,22);
  129.                         Writeln('Printing, Stand by. Press Esc to stop printing.');
  130.                         PrintLabels;
  131.                         GotoXY(1,22);
  132.                         Writeln('                                               ');
  133.                       end;
  134.             else      begin
  135.                         LineNo := LineNo + 1;
  136.                         if LineNo > 5 then LineNo := 0;
  137.                       end;
  138.             end {Case}
  139.          else
  140.             begin
  141.                LineNo := LineNo + 1;
  142.                if LineNo > 5 then LineNo := 0;
  143.             end;
  144.       end; {while}
  145.   CursorOn;
  146.   RestoreScreen(ScrnPtr);
  147.   GotoXY(CursorX,CursorY);
  148. end.
  149.